Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/sheriffa/main.bas

BASIC Source File | 1999-05-29 | 6.0 KB | 205 lines

Attribute VB_Name = "MainVB"
Public Const PRODUCT_ID = "9758-3050-1918-9292-6466"
Public Const PRODUCT_NAME = "SlsDemo VB version"
Public Const USER_NAME = "SlsDemo VB User"
Public Const LICENCE_PATH = "c:\temp"
Public Const LICENCE_FULL = 1
Public Const LICENCE_DEMO = 2
Public Const LICENCE_EXIT = 3

Public Const RUN_FULL = 1
Public Const RUN_DEMO = 2

Public g_nRunMode As Integer
Public fMainForm As frmMain
Public Sheriff As Object


Sub Main()

    Dim hr As Long
    Set fMainForm = New frmMain

    Set Sheriff = CreateObject("Sheriff.Sheriff")
    'Initialize Sheriff
    Sheriff.ProductID = PRODUCT_ID
    Sheriff.ProductName = PRODUCT_NAME
    Sheriff.UserName = USER_NAME

    'First of all, Challenge Sheriff
    Dim bChallenge As Boolean
    bChallenge = ChallengeSheriff()
    If (bChallenge = False) Then
        End
    End If

    'Check if the product is installed
    Dim bProductLicensed As Boolean
    bProductLicensed = Sheriff.IsProductLicensed()
    If (bProductLicensed = False) Then
    'product is not yet installed
    'if you wish to issue a trial licence, carry on...
    'otherwise, exit from here
        Dim bIssue As Boolean
        bIssue = IssueTrialLicence()
        If (bIssue = False) Then
          End
        End If
    End If

    'Now, it is time to check the licence
    Dim nState As Integer
    nState = CheckLicence()
    Select Case nState
        Case LICENCE_FULL
        'Run in full mode
            g_nRunMode = RUN_FULL
            fMainForm.Show 1
            hr = Sheriff.ReleaseLicence()
        Case LICENCE_DEMO
        'Run in demo mode
            g_nRunMode = RUN_DEMO
            fMainForm.Show 1
        Case LICENCE_EXIT
        'exit
    End Select

    Set Sheriff = Nothing
    Set fMainForm = Nothing

End Sub
Public Function ChallengeSheriff() As Boolean
    Dim Question As String
    Dim Answer As String

    Question = "Hello, Sheriff"
    hr = Sheriff.Challenge(Question, Answer)
    'Verify the Challenge
    Dim Challenger As Object
    Set Challenger = CreateObject("Sheriff.Challenger")
    'Initialize the Challenger with secret codes
    Challenger.Secret1 = "0763198532076621"
    Challenger.Secret2 = "1854207641987532"
    Challenger.Secret3 = "2482159326044927"
    Challenger.Secret4 = "3739062895179618"
    Dim ok As Boolean
    ok = Challenger.VerifyChallenge(Question, Answer)
    If (ok = False) Then
        MsgBox "Challenge Failed"
        'exit now
        ChallengeSheriff = False
        End
    End If
    'we're done with the Challenger, let it go
    Set Challenger = Nothing
    ChallengeSheriff = True
End Function

Public Function IssueTrialLicence() As Boolean
    'register product
    Dim hr As Long

    hr = Sheriff.RegisterLicence(LICENCE_PATH)

    'issue a trial licence
    'set licence policy
    Sheriff.AccessKey = 1  'level one
    Sheriff.CoUsers = 1    'single user
    Sheriff.Meter = 30     '30 days limit
    Sheriff.EndDate = #1/1/1980#    'no expiry
    Sheriff.Type = SLS_TYPE_TIME_METER + SLS_TYPE_CONCURRENCY

    'We have to support challenge
    Dim Challenger As Object
    Set Challenger = CreateObject("Sheriff.Challenger")
    'Initialize the Challenger with secret codes
    Challenger.Secret1 = "0763198532076621"
    Challenger.Secret2 = "1854207641987532"
    Challenger.Secret3 = "2482159326044927"
    Challenger.Secret4 = "3739062895179618"

    Dim ChallenegingData As String
    Dim ChallengedData As String

    ChallengingData = Sheriff.GetChallengeData()
    hr = Challenger.CreateChallenge(ChallengingData, ChallengedData)

    hr = Sheriff.IssueLicence(ChallengedData)
    If (FAILED(hr)) Then
        strTitle = "SlsDemoVB"
        Dim strErrorMsg As String
        strErrorMsg = String$(256, 0)
        hr = Sheriff.GetErrorMessage(hr, strErrorMsg)
        MsgBox strErrorMsg, vbExclamation, strTitle
        IssueTrialLicence = False
        End
    End If

    'we're done with the Challenger, let it go
    Set Challenger = Nothing

    IssueTrialLicence = True
End Function

Public Function CheckLicence() As Integer
    Dim hr As Long
    Dim AccessKey As Long

    hr = Sheriff.RequestLicence(AccessKey)
    If (SUCCEEDED(hr)) Then
        'query licence information
        hr = Sheriff.QueryLicenceInfo
        If (SUCCEEDED(hr)) Then
        'you may want to check the licence info
        '....
        End If

        CheckLicence = LICENCE_FULL
        Exit Function
    End If

    'Licence is not ready yet
    If (hr = SLS_E_LICENCE_UNREGISTERED) Then
        hr = Sheriff.RegisterLicence(LICENCE_PATH)
        If (FAILED(hr)) Then
            'error in licence registration
            Dim strTitle As String
            strTitle = "Licence Registation"
            Dim strErrorMsg As String
            strErrorMsg = String$(256, 0)
            hr = Sheriff.GetLastErrorMessage(strErrorMsg)
            MsgBox strErrorMsg, vbExclamation, strTitle
            CheckLicence = LICENCE_EXIT
            Exit Function
        End If
        'Register licence
        frmRegister.Show 1
        CheckLicence = frmRegister.GetRegisterState()
        Exit Function
    End If
    If (hr = SLS_E_LICENCE_UNDEFINED) Then
    'Licence not defined yet

        frmRegister.Show 1
        CheckLicence = frmRegister.GetRegisterState()
        Exit Function
    End If
    If (hr = SLS_E_LICENCE_EXPIRED) Then
    'Licence has expired
    'To do,add code here
        Exit Function
    End If
    If (hr = SLS_E_LICENCE_EXCEEDED) Then
    'Licence concurency run out
    'To do,add code here
        Exit Function
    End If
    'Other error
    strTitle = "SlsDemoVB"
    strErrorMsg = String$(256, 0)
    hr = Sheriff.GetLastErrorMessage(strErrorMsg)
    MsgBox strErrorMsg, vbExclamation, strTitle
    CheckLicence = LICENCE_EXIT
End Function